home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff1.arc / DIRECTRY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-11-05  |  2.3 KB  |  68 lines
  1.  
  2. program DirList;
  3. {
  4.        This is a simple program to list out the directory of the
  5.        current (logged) drive.
  6. }
  7. type
  8.   Char12arr            = array [ 1..12 ] of Char;
  9.   String20             = string[ 20 ];
  10.   RegRec =
  11.     record
  12.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  13.     end;
  14.  
  15. var
  16.   Regs                 : RegRec;
  17.   DTA                  : array [ 1..43 ] of Byte;
  18.   Mask                 : Char12arr;
  19.   NamR                 : String20;
  20.   Error, I             : Integer;
  21.  
  22. begin { main body of program DirList }
  23.  
  24.   FillChar(DTA,SizeOf(DTA),0);        { Initialize the DTA buffer }
  25.   FillChar(Mask,SizeOf(Mask),0);      { Initialize the mask }
  26.   FillChar(NamR,SizeOf(NamR),0);      { Initialize the file name }
  27.  
  28.   WriteLn( 'Directory list program for MS-Dos.' );
  29.   WriteLn;
  30.   Regs.AX := $1A00;         { Function used to set the DTA }
  31.   Regs.DS := Seg(DTA);      { store the parameter segment in DS }
  32.   Regs.DX := Ofs(DTA);      {   "    "      "     offset in DX }
  33.   MSDos(Regs);              { Set DTA location }
  34.   Error := 0;
  35.   Mask := '????????.???';    { Use global search }
  36.   Regs.AX := $4E00;          { Get first directory entry }
  37.   Regs.DS := Seg(Mask);      { Point to the file Mask }
  38.   Regs.DX := Ofs(Mask);
  39.   Regs.CX := 22;             { Store the option }
  40.   MSDos(Regs);               { Execute MSDos call }
  41.   Error := Regs.AX and $FF;  { Get Error return }
  42.   I := 1;                    { initialize 'I' to the first element }
  43.   if (Error = 0) then
  44.     repeat
  45.       NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
  46.       I := I + 1;
  47.     until not (NamR[I-1] in [' '..'~']) or (I>20);
  48.  
  49.   NamR[0] := Chr(I-1);          { set string length because assigning }
  50.                                 { by element does not set length }
  51.   while (Error = 0) do begin
  52.     Error := 0;
  53.     Regs.AX := $4F00;           { Function used to get the next }
  54.                                 { directory entry }
  55.     Regs.CX := 22;              { Set the file option }
  56.     MSDos( Regs );              { Call MSDos }
  57.     Error := Regs.AX and $FF;   { get the Error return }
  58.     I := 1;
  59.     repeat
  60.       NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
  61.       I := I + 1;
  62.     until not (NamR[I-1] in [' '..'~'] ) or (I > 20);
  63.     NamR[0] := Chr(I-1);
  64.     if (Error = 0)
  65.       then WriteLn(NamR)
  66.   end
  67. end. { of program DirList  }
  68.